home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 2000 October / Software of the Month - Ultimate Collection Shareware 277.iso / pc / PROGRAMS / UTILITY / WINLINUX / DATA1.CAB / usr_-_Usr_Files / BIN / POD2MAN < prev    next >
Text File  |  1999-09-17  |  29KB  |  1,182 lines
  1. #!/usr/bin/perl
  2.     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  3.     if $running_under_some_shell;
  4.  
  5. $DEF_PM_SECTION = '3' || '3';
  6.  
  7. =head1 NAME
  8.  
  9. pod2man - translate embedded Perl pod directives into man pages
  10.  
  11. =head1 SYNOPSIS
  12.  
  13. B<pod2man>
  14. [ B<--section=>I<manext> ]
  15. [ B<--release=>I<relpatch> ]
  16. [ B<--center=>I<string> ]
  17. [ B<--date=>I<string> ]
  18. [ B<--fixed=>I<font> ]
  19. [ B<--official> ]
  20. [ B<--lax> ]
  21. I<inputfile>
  22.  
  23. =head1 DESCRIPTION
  24.  
  25. B<pod2man> converts its input file containing embedded pod directives (see
  26. L<perlpod>) into nroff source suitable for viewing with nroff(1) or
  27. troff(1) using the man(7) macro set.
  28.  
  29. Besides the obvious pod conversions, B<pod2man> also takes care of
  30. func(), func(n), and simple variable references like $foo or @bar so
  31. you don't have to use code escapes for them; complex expressions like
  32. C<$fred{'stuff'}> will still need to be escaped, though.  Other nagging
  33. little roffish things that it catches include translating the minus in
  34. something like foo-bar, making a long dash--like this--into a real em
  35. dash, fixing up "paired quotes", putting a little space after the
  36. parens in something like func(), making C++ and PI look right, making
  37. double underbars have a little tiny space between them, making ALLCAPS
  38. a teeny bit smaller in troff(1), and escaping backslashes so you don't
  39. have to.
  40.  
  41. =head1 OPTIONS
  42.  
  43. =over 8
  44.  
  45. =item center
  46.  
  47. Set the centered header to a specific string.  The default is
  48. "User Contributed Perl Documentation", unless the C<--official> flag is
  49. given, in which case the default is "Perl Programmers Reference Guide".
  50.  
  51. =item date
  52.  
  53. Set the left-hand footer string to this value.  By default,
  54. the modification date of the input file will be used.
  55.  
  56. =item fixed
  57.  
  58. The fixed font to use for code refs.  Defaults to CW.
  59.  
  60. =item official
  61.  
  62. Set the default header to indicate that this page is of
  63. the standard release in case C<--center> is not given.
  64.  
  65. =item release
  66.  
  67. Set the centered footer.  By default, this is the current
  68. perl release.
  69.  
  70. =item section
  71.  
  72. Set the section for the C<.TH> macro.  The standard conventions on
  73. sections are to use 1 for user commands,  2 for system calls, 3 for
  74. functions, 4 for devices, 5 for file formats, 6 for games, 7 for
  75. miscellaneous information, and 8 for administrator commands.  This works
  76. best if you put your Perl man pages in a separate tree, like
  77. F</usr/local/perl/man/>.  By default, section 1 will be used
  78. unless the file ends in F<.pm> in which case section 3 will be selected.
  79.  
  80. =item lax
  81.  
  82. Don't complain when required sections aren't present.
  83.  
  84. =back
  85.  
  86. =head1 Anatomy of a Proper Man Page
  87.  
  88. For those not sure of the proper layout of a man page, here's
  89. an example of the skeleton of a proper man page.  Head of the
  90. major headers should be setout as a C<=head1> directive, and
  91. are historically written in the rather startling ALL UPPER CASE
  92. format, although this is not mandatory.
  93. Minor headers may be included using C<=head2>, and are
  94. typically in mixed case.
  95.  
  96. =over 10
  97.  
  98. =item NAME
  99.  
  100. Mandatory section; should be a comma-separated list of programs or
  101. functions documented by this podpage, such as:
  102.  
  103.     foo, bar - programs to do something
  104.  
  105. =item SYNOPSIS
  106.  
  107. A short usage summary for programs and functions, which
  108. may someday be deemed mandatory.
  109.  
  110. =item DESCRIPTION
  111.  
  112. Long drawn out discussion of the program.  It's a good idea to break this
  113. up into subsections using the C<=head2> directives, like
  114.  
  115.     =head2 A Sample Subection
  116.  
  117.     =head2 Yet Another Sample Subection
  118.  
  119. =item OPTIONS
  120.  
  121. Some people make this separate from the description.
  122.  
  123. =item RETURN VALUE
  124.  
  125. What the program or function returns if successful.
  126.  
  127. =item ERRORS
  128.  
  129. Exceptions, return codes, exit stati, and errno settings.
  130.  
  131. =item EXAMPLES
  132.  
  133. Give some example uses of the program.
  134.  
  135. =item ENVIRONMENT
  136.  
  137. Envariables this program might care about.
  138.  
  139. =item FILES
  140.  
  141. All files used by the program.  You should probably use the FE<lt>E<gt>
  142. for these.
  143.  
  144. =item SEE ALSO
  145.  
  146. Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8).
  147.  
  148. =item NOTES
  149.  
  150. Miscellaneous commentary.
  151.  
  152. =item CAVEATS
  153.  
  154. Things to take special care with; sometimes called WARNINGS.
  155.  
  156. =item DIAGNOSTICS
  157.  
  158. All possible messages the program can print out--and
  159. what they mean.
  160.  
  161. =item BUGS
  162.  
  163. Things that are broken or just don't work quite right.
  164.  
  165. =item RESTRICTIONS
  166.  
  167. Bugs you don't plan to fix :-)
  168.  
  169. =item AUTHOR
  170.  
  171. Who wrote it (or AUTHORS if multiple).
  172.  
  173. =item HISTORY
  174.  
  175. Programs derived from other sources sometimes have this, or
  176. you might keep a modification log here.
  177.  
  178. =back
  179.  
  180. =head1 EXAMPLES
  181.  
  182.     pod2man program > program.1
  183.     pod2man some_module.pm > /usr/perl/man/man3/some_module.3
  184.     pod2man --section=7 note.pod > note.7
  185.  
  186. =head1 DIAGNOSTICS
  187.  
  188. The following diagnostics are generated by B<pod2man>.  Items
  189. marked "(W)" are non-fatal, whereas the "(F)" errors will cause
  190. B<pod2man> to immediately exit with a non-zero status.
  191.  
  192. =over 4
  193.  
  194. =item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s>
  195.  
  196. (W) If you start include an option, you should set it off
  197. as bold, italic, or code.
  198.  
  199. =item can't open %s: %s
  200.  
  201. (F) The input file wasn't available for the given reason.
  202.  
  203. =item Improper man page - no dash in NAME header in paragraph %d of %s
  204.  
  205. (W) The NAME header did not have an isolated dash in it.  This is
  206. considered important.
  207.  
  208. =item Invalid man page - no NAME line in %s
  209.  
  210. (F) You did not include a NAME header, which is essential.
  211.  
  212. =item roff font should be 1 or 2 chars, not `%s'  (F)
  213.  
  214. (F) The font specified with the C<--fixed> option was not
  215. a one- or two-digit roff font.
  216.  
  217. =item %s is missing required section: %s
  218.  
  219. (W) Required sections include NAME, DESCRIPTION, and if you're
  220. using a section starting with a 3, also a SYNOPSIS.  Actually,
  221. not having a NAME is a fatal.
  222.  
  223. =item Unknown escape: %s in %s
  224.  
  225. (W) An unknown HTML entity (probably for an 8-bit character) was given via
  226. a C<EE<lt>E<gt>> directive.  Besides amp, lt, gt, and quot, recognized
  227. entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
  228. Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
  229. Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
  230. icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc,
  231. ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig,
  232. THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml,
  233. Yacute, yacute, and yuml.
  234.  
  235. =item Unmatched =back
  236.  
  237. (W) You have a C<=back> without a corresponding C<=over>.
  238.  
  239. =item Unrecognized pod directive: %s
  240.  
  241. (W) You specified a pod directive that isn't in the known list of
  242. C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
  243.  
  244.  
  245. =back
  246.  
  247. =head1 NOTES
  248.  
  249. If you would like to print out a lot of man page continuously, you
  250. probably want to set the C and D registers to set contiguous page
  251. numbering and even/odd paging, at least on some versions of man(7).
  252. Settting the F register will get you some additional experimental
  253. indexing:
  254.  
  255.     troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ...
  256.  
  257. The indexing merely outputs messages via C<.tm> for each
  258. major page, section, subsection, item, and any C<XE<lt>E<gt>>
  259. directives.
  260.  
  261.  
  262. =head1 RESTRICTIONS
  263.  
  264. None at this time.
  265.  
  266. =head1 BUGS
  267.  
  268. The =over and =back directives don't really work right.  They
  269. take absolute positions instead of offsets, don't nest well, and
  270. making people count is suboptimal in any event.
  271.  
  272. =head1 AUTHORS
  273.  
  274. Original prototype by Larry Wall, but so massively hacked over by
  275. Tom Christiansen such that Larry probably doesn't recognize it anymore.
  276.  
  277. =cut
  278.  
  279. $/ = "";
  280. $cutting = 1;
  281. @Indices = ();
  282.  
  283. # We try first to get the version number from a local binary, in case we're
  284. # running an installed version of Perl to produce documentation from an
  285. # uninstalled newer version's pod files.
  286. if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
  287.   my $perl = (-x './perl' && -f './perl' ) ?
  288.                  './perl' :
  289.                  ((-x '../perl' && -f '../perl') ?
  290.                       '../perl' :
  291.                       '');
  292.   ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl;
  293. }
  294. # No luck; we'll just go with the running Perl's version
  295. ($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
  296. $DEF_RELEASE  = "perl $version";
  297. $DEF_RELEASE .= ", patch $patch" if $patch;
  298.  
  299.  
  300. sub makedate {
  301.     my $secs = shift;
  302.     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
  303.     my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
  304.     $year += 1900;
  305.     return "$mday/$mname/$year";
  306. }
  307.  
  308. use Getopt::Long;
  309.  
  310. $DEF_SECTION = 1;
  311. $DEF_CENTER = "User Contributed Perl Documentation";
  312. $STD_CENTER = "Perl Programmers Reference Guide";
  313. $DEF_FIXED = 'CW';
  314. $DEF_LAX = 0;
  315.  
  316. sub usage {
  317.     warn "$0: @_\n" if @_;
  318.     die <<EOF;
  319. usage: $0 [options] podpage
  320. Options are:
  321.     --section=manext      (default "$DEF_SECTION")
  322.     --release=relpatch    (default "$DEF_RELEASE")
  323.     --center=string       (default "$DEF_CENTER")
  324.     --date=string         (default "$DEF_DATE")
  325.     --fixed=font          (default "$DEF_FIXED")
  326.     --official          (default NOT)
  327.     --lax                 (default NOT)
  328. EOF
  329. }
  330.  
  331. $uok = GetOptions( qw(
  332.     section=s
  333.     release=s
  334.     center=s
  335.     date=s
  336.     fixed=s
  337.     official
  338.     lax
  339.     help));
  340.  
  341. $DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
  342.  
  343. usage("Usage error!") unless $uok;
  344. usage() if $opt_help;
  345. usage("Need one and only one podpage argument") unless @ARGV == 1;
  346.  
  347. $section = $opt_section || ($ARGV[0] =~ /\.pm$/
  348.                 ? $DEF_PM_SECTION : $DEF_SECTION);
  349. $RP = $opt_release || $DEF_RELEASE;
  350. $center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
  351. $lax = $opt_lax || $DEF_LAX;
  352.  
  353. $CFont = $opt_fixed || $DEF_FIXED;
  354.  
  355. if (length($CFont) == 2) {
  356.     $CFont_embed = "\\f($CFont";
  357. }
  358. elsif (length($CFont) == 1) {
  359.     $CFont_embed = "\\f$CFont";
  360. }
  361. else {
  362.     die "roff font should be 1 or 2 chars, not `$CFont_embed'";
  363. }
  364.  
  365. $date = $opt_date || $DEF_DATE;
  366.  
  367. for (qw{NAME DESCRIPTION}) {
  368. # for (qw{NAME DESCRIPTION AUTHOR}) {
  369.     $wanna_see{$_}++;
  370. }
  371. $wanna_see{SYNOPSIS}++ if $section =~ /^3/;
  372.  
  373.  
  374. $name = @ARGV ? $ARGV[0] : "<STDIN>";
  375. $Filename = $name;
  376. if ($section =~ /^1/) {
  377.     require File::Basename;
  378.     $name = uc File::Basename::basename($name);
  379. }
  380. $name =~ s/\.(pod|p[lm])$//i;
  381.  
  382. # Lose everything up to the first of
  383. #     */lib/*perl*    standard or site_perl module
  384. #     */*perl*/lib    from -D prefix=/opt/perl
  385. #     */*perl*/        random module hierarchy
  386. # which works.
  387. $name =~ s-//+-/-g;
  388. if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
  389.     or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
  390.     or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
  391.     # Lose ^site(_perl)?/.
  392.     $name =~ s-^site(_perl)?/--;
  393.     # Lose ^arch/.    (XXX should we use Config? Just for archname?)
  394.     $name =~ s~^(.*-$^O|$^O-.*)/~~o;
  395.     # Lose ^version/.
  396.     $name =~ s-^\d+\.\d+/--;
  397. }
  398.  
  399. # Translate Getopt/Long to Getopt::Long, etc.
  400. $name =~ s(/)(::)g;
  401.  
  402. if ($name ne 'something') {
  403.     FCHECK: {
  404.     open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
  405.     while (<F>) {
  406.         next unless /^=\b/;
  407.         if (/^=head1\s+NAME\s*$/) {  # an /m would forgive mistakes
  408.         $_ = <F>;
  409.         unless (/\s*-+\s+/) {
  410.             $oops++;
  411.             warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
  412.                 } else {
  413.             my @n = split /\s+-+\s+/;
  414.             if (@n != 2) {
  415.             $oops++;
  416.             warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n"
  417.             }
  418.             else {
  419.             %namedesc = @n;
  420.             }
  421.         }
  422.         last FCHECK;
  423.         }
  424.         next if /^=cut\b/;    # DB_File and Net::Ping have =cut before NAME
  425.         next if /^=pod\b/;  # It is OK to have =pod before NAME
  426.         die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax;
  427.     }
  428.     die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax;
  429.     }
  430.     close F;
  431. }
  432.  
  433. print <<"END";
  434. .rn '' }`
  435. ''' \$RCSfile\$\$Revision\$\$Date\$
  436. '''
  437. ''' \$Log\$
  438. '''
  439. .de Sh
  440. .br
  441. .if t .Sp
  442. .ne 5
  443. .PP
  444. \\fB\\\\\$1\\fR
  445. .PP
  446. ..
  447. .de Sp
  448. .if t .sp .5v
  449. .if n .sp
  450. ..
  451. .de Ip
  452. .br
  453. .ie \\\\n(.\$>=3 .ne \\\\\$3
  454. .el .ne 3
  455. .IP "\\\\\$1" \\\\\$2
  456. ..
  457. .de Vb
  458. .ft $CFont
  459. .nf
  460. .ne \\\\\$1
  461. ..
  462. .de Ve
  463. .ft R
  464.  
  465. .fi
  466. ..
  467. '''
  468. '''
  469. '''     Set up \\*(-- to give an unbreakable dash;
  470. '''     string Tr holds user defined translation string.
  471. '''     Bell System Logo is used as a dummy character.
  472. '''
  473. .tr \\(*W-|\\(bv\\*(Tr
  474. .ie n \\{\\
  475. .ds -- \\(*W-
  476. .ds PI pi
  477. .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
  478. .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
  479. .ds L" ""
  480. .ds R" ""
  481. '''   \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of
  482. '''   \\*(L" and \\*(R", except that they are used on ".xx" lines,
  483. '''   such as .IP and .SH, which do another additional levels of
  484. '''   double-quote interpretation
  485. .ds M" """
  486. .ds S" """
  487. .ds N" """""
  488. .ds T" """""
  489. .ds L' '
  490. .ds R' '
  491. .ds M' '
  492. .ds S' '
  493. .ds N' '
  494. .ds T' '
  495. 'br\\}
  496. .el\\{\\
  497. .ds -- \\(em\\|
  498. .tr \\*(Tr
  499. .ds L" ``
  500. .ds R" ''
  501. .ds M" ``
  502. .ds S" ''
  503. .ds N" ``
  504. .ds T" ''
  505. .ds L' `
  506. .ds R' '
  507. .ds M' `
  508. .ds S' '
  509. .ds N' `
  510. .ds T' '
  511. .ds PI \\(*p
  512. 'br\\}
  513. END
  514.  
  515. print <<'END';
  516. .\"    If the F register is turned on, we'll generate
  517. .\"    index entries out stderr for the following things:
  518. .\"        TH    Title 
  519. .\"        SH    Header
  520. .\"        Sh    Subsection 
  521. .\"        Ip    Item
  522. .\"        X<>    Xref  (embedded
  523. .\"    Of course, you have to process the output yourself
  524. .\"    in some meaninful fashion.
  525. .if \nF \{
  526. .de IX
  527. .tm Index:\\$1\t\\n%\t"\\$2"
  528. ..
  529. .nr % 0
  530. .rr F
  531. .\}
  532. END
  533.  
  534. print <<"END";
  535. .TH $name $section "$RP" "$date" "$center"
  536. .UC
  537. END
  538.  
  539. push(@Indices, qq{.IX Title "$name $section"});
  540.  
  541. while (($name, $desc) = each %namedesc) {
  542.     for ($name, $desc) { s/^\s+//; s/\s+$//; }
  543.     push(@Indices, qq(.IX Name "$name - $desc"\n));
  544. }
  545.  
  546. print <<'END';
  547. .if n .hy 0
  548. .if n .na
  549. .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
  550. .de CQ          \" put $1 in typewriter font
  551. END
  552. print ".ft $CFont\n";
  553. print <<'END';
  554. 'if n "\c
  555. 'if t \\&\\$1\c
  556. 'if n \\&\\$1\c
  557. 'if n \&"
  558. \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
  559. '.ft R
  560. ..
  561. .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
  562. .    \" AM - accent mark definitions
  563. .bd B 3
  564. .    \" fudge factors for nroff and troff
  565. .if n \{\
  566. .    ds #H 0
  567. .    ds #V .8m
  568. .    ds #F .3m
  569. .    ds #[ \f1
  570. .    ds #] \fP
  571. .\}
  572. .if t \{\
  573. .    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
  574. .    ds #V .6m
  575. .    ds #F 0
  576. .    ds #[ \&
  577. .    ds #] \&
  578. .\}
  579. .    \" simple accents for nroff and troff
  580. .if n \{\
  581. .    ds ' \&
  582. .    ds ` \&
  583. .    ds ^ \&
  584. .    ds , \&
  585. .    ds ~ ~
  586. .    ds ? ?
  587. .    ds ! !
  588. .    ds /
  589. .    ds q
  590. .\}
  591. .if t \{\
  592. .    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
  593. .    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
  594. .    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
  595. .    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
  596. .    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
  597. .    ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
  598. .    ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
  599. .    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
  600. .    ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10'
  601. .\}
  602. .    \" troff and (daisy-wheel) nroff accents
  603. .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
  604. .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
  605. .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
  606. .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
  607. .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
  608. .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
  609. .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
  610. .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
  611. .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
  612. .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
  613. .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
  614. .ds ae a\h'-(\w'a'u*4/10)'e
  615. .ds Ae A\h'-(\w'A'u*4/10)'E
  616. .ds oe o\h'-(\w'o'u*4/10)'e
  617. .ds Oe O\h'-(\w'O'u*4/10)'E
  618. .    \" corrections for vroff
  619. .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
  620. .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
  621. .    \" for low resolution devices (crt and lpr)
  622. .if \n(.H>23 .if \n(.V>19 \
  623. \{\
  624. .    ds : e
  625. .    ds 8 ss
  626. .    ds v \h'-1'\o'\(aa\(ga'
  627. .    ds _ \h'-1'^
  628. .    ds . \h'-1'.
  629. .    ds 3 3
  630. .    ds o a
  631. .    ds d- d\h'-1'\(ga
  632. .    ds D- D\h'-1'\(hy
  633. .    ds th \o'bp'
  634. .    ds Th \o'LP'
  635. .    ds ae ae
  636. .    ds Ae AE
  637. .    ds oe oe
  638. .    ds Oe OE
  639. .\}
  640. .rm #[ #] #H #V #F C
  641. END
  642.  
  643. $indent = 0;
  644.  
  645. $begun = "";
  646.  
  647. # Unrolling [^A-Z>]|[A-Z](?!<) gives:    // MRE pp 165.
  648. my $nonest = '(?:[^A-Z>]*(?:[A-Z](?!<)[^A-Z>]*)*)';
  649.  
  650. while (<>) {
  651.     if ($cutting) {
  652.     next unless /^=/;
  653.     $cutting = 0;
  654.     }
  655.     if ($begun) {
  656.     if (/^=end\s+$begun/) {
  657.             $begun = "";
  658.     }
  659.     elsif ($begun =~ /^(roff|man)$/) {
  660.         print STDOUT $_;
  661.         }
  662.     next;
  663.     }
  664.     chomp;
  665.  
  666.     # Translate verbatim paragraph
  667.  
  668.     if (/^\s/) {
  669.     @lines = split(/\n/);
  670.     for (@lines) {
  671.         1 while s
  672.         {^( [^\t]* ) \t ( \t* ) }
  673.         { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
  674.         s/\\/\\e/g;
  675.         s/\A/\\&/s;
  676.     }
  677.     $lines = @lines;
  678.     makespace() unless $verbatim++;
  679.     print ".Vb $lines\n";
  680.     print join("\n", @lines), "\n";
  681.     print ".Ve\n";
  682.     $needspace = 0;
  683.     next;
  684.     }
  685.  
  686.     $verbatim = 0;
  687.  
  688.     if (/^=for\s+(\S+)\s*/s) {
  689.     if ($1 eq "man" or $1 eq "roff") {
  690.         print STDOUT $',"\n\n";
  691.     } else {
  692.         # ignore unknown for
  693.     }
  694.     next;
  695.     }
  696.     elsif (/^=begin\s+(\S+)\s*/s) {
  697.     $begun = $1;
  698.     if ($1 eq "man" or $1 eq "roff") {
  699.         print STDOUT $'."\n\n";
  700.     }
  701.     next;
  702.     }
  703.  
  704.     # check for things that'll hosed our noremap scheme; affects $_
  705.     init_noremap();
  706.  
  707.     if (!/^=item/) {
  708.  
  709.     # trofficate backslashes; must do it before what happens below
  710.     s/\\/noremap('\\e')/ge;
  711.  
  712.     # protect leading periods and quotes against *roff
  713.     # mistaking them for directives
  714.     s/^(?:[A-Z]<)?[.']/\\&$&/gm;
  715.  
  716.     # first hide the escapes in case we need to
  717.     # intuit something and get it wrong due to fmting
  718.  
  719.     1 while s/([A-Z]<$nonest>)/noremap($1)/ge;
  720.  
  721.     # func() is a reference to a perl function
  722.     s{
  723.         \b
  724.         (
  725.         [:\w]+ \(\)
  726.         )
  727.     } {I<$1>}gx;
  728.  
  729.     # func(n) is a reference to a perl function or a man page
  730.     s{
  731.         ([:\w]+)
  732.         (
  733.         \( [^\051]+ \)
  734.         )
  735.     } {I<$1>\\|$2}gx;
  736.  
  737.     # convert simple variable references
  738.     s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g;
  739.  
  740.     if (m{ (
  741.             [\-\w]+
  742.             \(
  743.             [^\051]*?
  744.             [\@\$,]
  745.             [^\051]*?
  746.             \)
  747.         )
  748.         }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
  749.     {
  750.         warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
  751.         $oops++;
  752.     }
  753.  
  754.     while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
  755.         warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
  756.         $oops++;
  757.     }
  758.  
  759.     # put it back so we get the <> processed again;
  760.     clear_noremap(0); # 0 means leave the E's
  761.  
  762.     } else {
  763.     # trofficate backslashes
  764.     s/\\/noremap('\\e')/ge;
  765.  
  766.     }
  767.  
  768.     # need to hide E<> first; they're processed in clear_noremap
  769.     s/(E<[^<>]+>)/noremap($1)/ge;
  770.  
  771.  
  772.     $maxnest = 10;
  773.     while ($maxnest-- && /[A-Z]</) {
  774.  
  775.     # can't do C font here
  776.     s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg;
  777.  
  778.     # files and filelike refs in italics
  779.     s/F<($nonest)>/I<$1>/g;
  780.  
  781.     # no break -- usually we want C<> for this
  782.     s/S<($nonest)>/nobreak($1)/eg;
  783.  
  784.     # LREF: a la HREF L<show this text|man/section>
  785.     s:L<([^|>]+)\|[^>]+>:$1:g;
  786.  
  787.     # LREF: a manpage(3f)
  788.     s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
  789.  
  790.     # LREF: an =item on another manpage
  791.     s{
  792.         L<
  793.         ([^/]+)
  794.         /
  795.         (
  796.             [:\w]+
  797.             (\(\))?
  798.         )
  799.         >
  800.     } {the C<$2> entry in the I<$1> manpage}gx;
  801.  
  802.     # LREF: an =item on this manpage
  803.     s{
  804.        ((?:
  805.         L<
  806.         /
  807.         (
  808.             [:\w]+
  809.             (\(\))?
  810.         )
  811.         >
  812.         (,?\s+(and\s+)?)?
  813.       )+)
  814.     } { internal_lrefs($1) }gex;
  815.  
  816.     # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
  817.     # the "func" can disambiguate
  818.     s{
  819.         L<
  820.         (?:
  821.             ([a-zA-Z]\S+?) /
  822.         )?
  823.         "?(.*?)"?
  824.         >
  825.     }{
  826.         do {
  827.         $1     # if no $1, assume it means on this page.
  828.             ?  "the section on I<$2> in the I<$1> manpage"
  829.             :  "the section on I<$2>"
  830.         }
  831.     }gesx; # s in case it goes over multiple lines, so . matches \n
  832.  
  833.     s/Z<>/\\&/g;
  834.  
  835.     # comes last because not subject to reprocessing
  836.     s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg;
  837.     }
  838.  
  839.     if (s/^=//) {
  840.     $needspace = 0;        # Assume this.
  841.  
  842.     s/\n/ /g;
  843.  
  844.     ($Cmd, $_) = split(' ', $_, 2);
  845.  
  846.     $dotlevel = 1;
  847.     if ($Cmd eq 'head1') {
  848.        $dotlevel = 1;
  849.     }
  850.     elsif ($Cmd eq 'head2') {
  851.        $dotlevel = 1;
  852.     }
  853.     elsif ($Cmd eq 'item') {
  854.        $dotlevel = 2;
  855.     }
  856.  
  857.     if (defined $_) {
  858.         &escapes($dotlevel);
  859.         s/"/""/g;
  860.     }
  861.  
  862.     clear_noremap(1);
  863.  
  864.     if ($Cmd eq 'cut') {
  865.         $cutting = 1;
  866.     }
  867.     elsif ($Cmd eq 'head1') {
  868.         s/\s+$//;
  869.         delete $wanna_see{$_} if exists $wanna_see{$_};
  870.         print qq{.SH "$_"\n};
  871.       push(@Indices, qq{.IX Header "$_"\n});
  872.     }
  873.     elsif ($Cmd eq 'head2') {
  874.         print qq{.Sh "$_"\n};
  875.       push(@Indices, qq{.IX Subsection "$_"\n});
  876.     }
  877.     elsif ($Cmd eq 'over') {
  878.         push(@indent,$indent);
  879.         $indent += ($_ + 0) || 5;
  880.     }
  881.     elsif ($Cmd eq 'back') {
  882.         $indent = pop(@indent);
  883.         warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
  884.         $needspace = 1;
  885.     }
  886.     elsif ($Cmd eq 'item') {
  887.         s/^\*( |$)/\\(bu$1/g;
  888.         # if you know how to get ":s please do
  889.         s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g;
  890.         s/\\\*\(L"([^"]+?)""/'$1'/g;
  891.         s/[^"]""([^"]+?)""[^"]/'$1'/g;
  892.         # here do something about the $" in perlvar?
  893.         print STDOUT qq{.Ip "$_" $indent\n};
  894.       push(@Indices, qq{.IX Item "$_"\n});
  895.     }
  896.     elsif ($Cmd eq 'pod') {
  897.         # this is just a comment
  898.     } 
  899.     else {
  900.         warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
  901.     }
  902.     }
  903.     else {
  904.     if ($needspace) {
  905.         &makespace;
  906.     }
  907.     &escapes(0);
  908.     clear_noremap(1);
  909.     print $_, "\n";
  910.     $needspace = 1;
  911.     }
  912. }
  913.  
  914. print <<"END";
  915.  
  916. .rn }` ''
  917. END
  918.  
  919. if (%wanna_see && !$lax) {
  920.     @missing = keys %wanna_see;
  921.     warn "$0: $Filename is missing required section"
  922.     .  (@missing > 1 && "s")
  923.     .  ": @missing\n";
  924.     $oops++;
  925. }
  926.  
  927. foreach (@Indices) { print "$_\n"; }
  928.  
  929. exit;
  930. #exit ($oops != 0);
  931.  
  932. #########################################################################
  933.  
  934. sub nobreak {
  935.     my $string = shift;
  936.     $string =~ s/ /\\ /g;
  937.     $string;
  938. }
  939.  
  940. sub escapes {
  941.     my $indot = shift;
  942.  
  943.     s/X<(.*?)>/mkindex($1)/ge;
  944.  
  945.     # translate the minus in foo-bar into foo\-bar for roff
  946.     s/([^0-9a-z-])-([^-])/$1\\-$2/g;
  947.  
  948.     # make -- into the string version \*(-- (defined above)
  949.     s/\b--\b/\\*(--/g;
  950.     s/"--([^"])/"\\*(--$1/g;  # should be a better way
  951.     s/([^"])--"/$1\\*(--"/g;
  952.  
  953.     # fix up quotes; this is somewhat tricky
  954.     my $dotmacroL = 'L';
  955.     my $dotmacroR = 'R';
  956.     if ( $indot == 1 ) {
  957.     $dotmacroL = 'M';
  958.     $dotmacroR = 'S';
  959.     }  
  960.     elsif ( $indot >= 2 ) {
  961.     $dotmacroL = 'N';
  962.     $dotmacroR = 'T';
  963.     }  
  964.     if (!/""/) {
  965.     s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge;
  966.     s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge;
  967.     }
  968.  
  969.     #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
  970.     #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
  971.  
  972.  
  973.     # make sure that func() keeps a bit a space tween the parens
  974.     ### s/\b\(\)/\\|()/g;
  975.     ### s/\b\(\)/(\\|)/g;
  976.  
  977.     # make C++ into \*C+, which is a squinched version (defined above)
  978.     s/\bC\+\+/\\*(C+/g;
  979.  
  980.     # make double underbars have a little tiny space between them
  981.     s/__/_\\|_/g;
  982.  
  983.     # PI goes to \*(PI (defined above)
  984.     s/\bPI\b/noremap('\\*(PI')/ge;
  985.  
  986.     # make all caps a teeny bit smaller, but don't muck with embedded code literals
  987.     my $hidCFont = font('C');
  988.     if ($Cmd !~ /^head1/) { # SH already makes smaller
  989.     # /g isn't enough; 1 while or we'll be off
  990.  
  991. #    1 while s{
  992. #        (?!$hidCFont)(..|^.|^)
  993. #        \b
  994. #        (
  995. #        [A-Z][\/A-Z+:\-\d_$.]+
  996. #        )
  997. #        (s?)         
  998. #        \b
  999. #    } {$1\\s-1$2\\s0}gmox;
  1000.  
  1001.     1 while s{
  1002.         (?!$hidCFont)(..|^.|^)
  1003.         (
  1004.         \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
  1005.         )
  1006.     } {
  1007.         $1 . noremap( '\\s-1' .  $2 . '\\s0' )
  1008.     }egmox;
  1009.  
  1010.     }
  1011. }
  1012.  
  1013. # make troff just be normal, but make small nroff get quoted
  1014. # decided to just put the quotes in the text; sigh;
  1015. sub ccvt {
  1016.     local($_,$prev) = @_;
  1017.     noremap(qq{.CQ "$_" \n\\&});
  1018. }
  1019.  
  1020. sub makespace {
  1021.     if ($indent) {
  1022.     print ".Sp\n";
  1023.     }
  1024.     else {
  1025.     print ".PP\n";
  1026.     }
  1027. }
  1028.  
  1029. sub mkindex {
  1030.     my ($entry) = @_;
  1031.     my @entries = split m:\s*/\s*:, $entry;
  1032.     push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries;
  1033.     return '';
  1034. }
  1035.  
  1036. sub font {
  1037.     local($font) = shift;
  1038.     return '\\f' . noremap($font);
  1039. }
  1040.  
  1041. sub noremap {
  1042.     local($thing_to_hide) = shift;
  1043.     $thing_to_hide =~ tr/\000-\177/\200-\377/;
  1044.     return $thing_to_hide;
  1045. }
  1046.  
  1047. sub init_noremap {
  1048.     # escape high bit characters in input stream
  1049.     s/([\200-\377])/"E<".ord($1).">"/ge;
  1050. }
  1051.  
  1052. sub clear_noremap {
  1053.     my $ready_to_print = $_[0];
  1054.  
  1055.     tr/\200-\377/\000-\177/;
  1056.  
  1057.     # trofficate backslashes
  1058.     # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
  1059.  
  1060.     # now for the E<>s, which have been hidden until now
  1061.     # otherwise the interative \w<> processing would have
  1062.     # been hosed by the E<gt>
  1063.     s {
  1064.         E<
  1065.         (
  1066.             ( \d + ) 
  1067.             | ( [A-Za-z]+ )    
  1068.         )
  1069.         >    
  1070.     } {
  1071.      do {
  1072.          defined $2
  1073.         ? chr($2)
  1074.         :    
  1075.          exists $HTML_Escapes{$3}
  1076.         ? do { $HTML_Escapes{$3} }
  1077.         : do {
  1078.             warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
  1079.             "E<$1>";
  1080.         }
  1081.      }
  1082.     }egx if $ready_to_print;
  1083. }
  1084.  
  1085. sub internal_lrefs {
  1086.     local($_) = shift;
  1087.     local $trailing_and = s/and\s+$// ? "and " : "";
  1088.  
  1089.     s{L</([^>]+)>}{$1}g;
  1090.     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
  1091.     my $retstr = "the ";
  1092.     my $i;
  1093.     for ($i = 0; $i <= $#items; $i++) {
  1094.     $retstr .= "C<$items[$i]>";
  1095.     $retstr .= ", " if @items > 2 && $i != $#items;
  1096.     $retstr .= " and " if $i+2 == @items;
  1097.     }
  1098.  
  1099.     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
  1100.         .  " elsewhere in this document";
  1101.     # terminal space to avoid words running together (pattern used
  1102.     # strips terminal spaces)
  1103.     $retstr .= " " if length $trailing_and;
  1104.     $retstr .=  $trailing_and;
  1105.  
  1106.     return $retstr;
  1107.  
  1108. }
  1109.  
  1110. BEGIN {
  1111. %HTML_Escapes = (
  1112.     'amp'    =>    '&',    #   ampersand
  1113.     'lt'    =>    '<',    #   left chevron, less-than
  1114.     'gt'    =>    '>',    #   right chevron, greater-than
  1115.     'quot'    =>    '"',    #   double quote
  1116.  
  1117.     "Aacute"    =>    "A\\*'",    #   capital A, acute accent
  1118.     "aacute"    =>    "a\\*'",    #   small a, acute accent
  1119.     "Acirc"    =>    "A\\*^",    #   capital A, circumflex accent
  1120.     "acirc"    =>    "a\\*^",    #   small a, circumflex accent
  1121.     "AElig"    =>    '\*(AE',    #   capital AE diphthong (ligature)
  1122.     "aelig"    =>    '\*(ae',    #   small ae diphthong (ligature)
  1123.     "Agrave"    =>    "A\\*`",    #   capital A, grave accent
  1124.     "agrave"    =>    "A\\*`",    #   small a, grave accent
  1125.     "Aring"    =>    'A\\*o',    #   capital A, ring
  1126.     "aring"    =>    'a\\*o',    #   small a, ring
  1127.     "Atilde"    =>    'A\\*~',    #   capital A, tilde
  1128.     "atilde"    =>    'a\\*~',    #   small a, tilde
  1129.     "Auml"    =>    'A\\*:',    #   capital A, dieresis or umlaut mark
  1130.     "auml"    =>    'a\\*:',    #   small a, dieresis or umlaut mark
  1131.     "Ccedil"    =>    'C\\*,',    #   capital C, cedilla
  1132.     "ccedil"    =>    'c\\*,',    #   small c, cedilla
  1133.     "Eacute"    =>    "E\\*'",    #   capital E, acute accent
  1134.     "eacute"    =>    "e\\*'",    #   small e, acute accent
  1135.     "Ecirc"    =>    "E\\*^",    #   capital E, circumflex accent
  1136.     "ecirc"    =>    "e\\*^",    #   small e, circumflex accent
  1137.     "Egrave"    =>    "E\\*`",    #   capital E, grave accent
  1138.     "egrave"    =>    "e\\*`",    #   small e, grave accent
  1139.     "ETH"    =>    '\\*(D-',    #   capital Eth, Icelandic
  1140.     "eth"    =>    '\\*(d-',    #   small eth, Icelandic
  1141.     "Euml"    =>    "E\\*:",    #   capital E, dieresis or umlaut mark
  1142.     "euml"    =>    "e\\*:",    #   small e, dieresis or umlaut mark
  1143.     "Iacute"    =>    "I\\*'",    #   capital I, acute accent
  1144.     "iacute"    =>    "i\\*'",    #   small i, acute accent
  1145.     "Icirc"    =>    "I\\*^",    #   capital I, circumflex accent
  1146.     "icirc"    =>    "i\\*^",    #   small i, circumflex accent
  1147.     "Igrave"    =>    "I\\*`",    #   capital I, grave accent
  1148.     "igrave"    =>    "i\\*`",    #   small i, grave accent
  1149.     "Iuml"    =>    "I\\*:",    #   capital I, dieresis or umlaut mark
  1150.     "iuml"    =>    "i\\*:",    #   small i, dieresis or umlaut mark
  1151.     "Ntilde"    =>    'N\*~',        #   capital N, tilde
  1152.     "ntilde"    =>    'n\*~',        #   small n, tilde
  1153.     "Oacute"    =>    "O\\*'",    #   capital O, acute accent
  1154.     "oacute"    =>    "o\\*'",    #   small o, acute accent
  1155.     "Ocirc"    =>    "O\\*^",    #   capital O, circumflex accent
  1156.     "ocirc"    =>    "o\\*^",    #   small o, circumflex accent
  1157.     "Ograve"    =>    "O\\*`",    #   capital O, grave accent
  1158.     "ograve"    =>    "o\\*`",    #   small o, grave accent
  1159.     "Oslash"    =>    "O\\*/",    #   capital O, slash
  1160.     "oslash"    =>    "o\\*/",    #   small o, slash
  1161.     "Otilde"    =>    "O\\*~",    #   capital O, tilde
  1162.     "otilde"    =>    "o\\*~",    #   small o, tilde
  1163.     "Ouml"    =>    "O\\*:",    #   capital O, dieresis or umlaut mark
  1164.     "ouml"    =>    "o\\*:",    #   small o, dieresis or umlaut mark
  1165.     "szlig"    =>    '\*8',        #   small sharp s, German (sz ligature)
  1166.     "THORN"    =>    '\\*(Th',    #   capital THORN, Icelandic
  1167.     "thorn"    =>    '\\*(th',,    #   small thorn, Icelandic
  1168.     "Uacute"    =>    "U\\*'",    #   capital U, acute accent
  1169.     "uacute"    =>    "u\\*'",    #   small u, acute accent
  1170.     "Ucirc"    =>    "U\\*^",    #   capital U, circumflex accent
  1171.     "ucirc"    =>    "u\\*^",    #   small u, circumflex accent
  1172.     "Ugrave"    =>    "U\\*`",    #   capital U, grave accent
  1173.     "ugrave"    =>    "u\\*`",    #   small u, grave accent
  1174.     "Uuml"    =>    "U\\*:",    #   capital U, dieresis or umlaut mark
  1175.     "uuml"    =>    "u\\*:",    #   small u, dieresis or umlaut mark
  1176.     "Yacute"    =>    "Y\\*'",    #   capital Y, acute accent
  1177.     "yacute"    =>    "y\\*'",    #   small y, acute accent
  1178.     "yuml"    =>    "y\\*:",    #   small y, dieresis or umlaut mark
  1179. );
  1180. }
  1181.  
  1182.